home *** CD-ROM | disk | FTP | other *** search
/ Gigarom 1 / Gigarom Macintosh Archives (Quantum Leap)(CDRM1080320)(1993).iso / FILES / DEM / D-H / Effects Specialist.sea / EffectsSpecialistDemo™.rsrc / FYps_30000_Background Generator < prev    next >
Text File  |  1991-06-19  |  6KB  |  142 lines
  1. %! BACKGROUND GENERATOR 2.0
  2. %% ©1986-1991, Postcraft International, Inc., All Rights Reserved
  3. %% 91/02/24 Designed by Paul McLellan
  4. %% For use only in files created by Effects Specialist.
  5. /docomplex true def
  6. Shade1 /B1v exch def /B1b exch def /B1g exch def /B1r exch def
  7. Shade2 /B2v exch def /B2b exch def /B2g exch def /B2r exch def
  8. gsave
  9. newpath llx lly moveto  llx ury lineto
  10.         urx ury lineto  urx lly lineto  closepath clip
  11. /Xwidth urx llx sub 2 div def
  12. /Ywidth ury lly sub 2 div def
  13. /Radius Xwidth dup mul Ywidth dup mul add sqrt def
  14. WashType 2 eq %% if wash is radial
  15.   { /gRad Radius abs def }
  16.   { WashAngle 0 eq WashAngle 180 eq or   %% if wash is horizontal
  17.     { /gRad Xwidth abs def
  18.       /gLen Ywidth abs def }
  19.     { WashAngle 90 eq WashAngle 270 eq or %% if wash is vertical
  20.       { /gRad Ywidth abs def 
  21.         /gLen Xwidth abs def }
  22.       { /Quad WashAngle 90 div truncate def
  23.         Quad 0 eq { /iAng 0   Ywidth Xwidth atan add def  /jAng 180 Ywidth Xwidth atan sub def } if
  24.         Quad 1 eq { /iAng 180 Ywidth Xwidth atan sub def  /jAng 180 Ywidth Xwidth atan add def } if
  25.         Quad 2 eq { /iAng 180 Ywidth Xwidth atan add def  /jAng 360 Ywidth Xwidth atan sub def } if
  26.         Quad 3 eq { /iAng 360 Ywidth Xwidth atan sub def  /jAng   0 Ywidth Xwidth atan add def } if
  27.         /gRad Radius  iAng WashAngle sub cos mul abs 1.1 mul def
  28.         /gLen Radius  jAng 90 add WashAngle sub cos mul abs 1.1 mul def } ifelse
  29.     } ifelse
  30.   } ifelse
  31. /GrayDiameter gRad 2 mul def
  32. TextAngle 0 eq TextAngle 180 eq or   %% text —
  33.   { /TextRadius Ywidth abs def }
  34.   { TextAngle 90 eq TextAngle 270 eq or  %% text |
  35.     { /TextRadius Xwidth abs def }
  36.     { /Quad TextAngle 90 div truncate def
  37.       Quad 0 eq { /iAng 180 Ywidth Xwidth atan sub def } if
  38.       Quad 1 eq { /iAng 180 Ywidth Xwidth atan add def } if
  39.       Quad 2 eq { /iAng 360 Ywidth Xwidth atan sub def } if
  40.       Quad 3 eq { /iAng   0 Ywidth Xwidth atan add def } if
  41.       /TextRadius Radius  iAng 90 add TextAngle sub cos mul abs 1.1 mul def } ifelse
  42.   } ifelse
  43. TextAngle 0 eq TextAngle 180 eq or   %% if text is horizontal
  44.   { /TextWidth Xwidth abs def }
  45.   { TextAngle 90 eq TextAngle 270 eq or  %% if text is vertical
  46.     { /TextWidth Ywidth abs def }
  47.     { /Quad TextAngle 90 div truncate def
  48.       Quad 0 eq { /iAng 0   Ywidth Xwidth atan add def } if
  49.       Quad 1 eq { /iAng 180 Ywidth Xwidth atan sub def } if
  50.       Quad 2 eq { /iAng 180 Ywidth Xwidth atan add def } if
  51.       Quad 3 eq { /iAng 360 Ywidth Xwidth atan sub def } if
  52.       /TextWidth  Radius  iAng TextAngle sub cos mul abs 1.1 mul def } ifelse
  53.   } ifelse
  54. Xwidth llx add  Ywidth lly add translate
  55. B1v B2v eq  B1b B2b eq  B1g B2g eq  B1r B2r eq  and and and
  56.   { /docomplex false def
  57.   WashType 3 eq %% Text
  58.   { /cx llx Xwidth add def    %% centre of page
  59.     /cy lly Ywidth add def
  60.     /eol? {currentpoint pop TextWidth gt} def
  61.     /mywhy 0 def
  62.     TextAngle rotate
  63.     0 TextRadius neg translate     
  64.     Font findfont [Size 0 0 Size 0 0 ] makefont setfont
  65.     B1r B1g B1b B1v SMG
  66.       { TextRadius neg  Size  TextRadius
  67.         { TextWidth neg 0 moveto
  68.           { currentpoint pop /cpx exch def
  69.             String show eol? {exit} if } loop
  70.           /mywhy mywhy Size 1.1 mul add def
  71.           0 Size 1.1 mul translate } for } if } if
  72.   WashType 2 eq  WashType 1 eq  WashType 0 eq  or or
  73.     { B1r B1g B1b B1v SMG
  74.       Xwidth llx add neg  Ywidth lly add neg translate
  75.       { newpath llx lly moveto  llx ury lineto
  76.         urx ury lineto  urx lly lineto  closepath fill
  77.         } if } if
  78.     } if
  79. WashType 3 eq docomplex and %% Text
  80. { /cx llx Xwidth add def        %% centre of page
  81.   /cy lly Ywidth add def
  82.   /gx cx WashAngle TextAngle sub cos gRad mul sub def
  83.   /gy cy WashAngle TextAngle sub sin gRad mul sub def
  84.   /backM WashAngle TextAngle sub
  85.         90 add
  86.         dup sin exch cos div def
  87.   /backB gy  backM gx mul  sub def
  88.   /distDeno 1  backM dup mul add sqrt  def
  89.   /eol? {currentpoint pop TextWidth gt} def
  90.   /pointred { %% x pointred rvalue
  91.     TextWidth add backM mul mywhy sub backB add abs distDeno div
  92.        gRad 2 mul div  B2r B1r sub mul B1r add } def
  93.   /pointgreen { %% x pointgreen gvalue
  94.     TextWidth add backM mul mywhy sub backB add abs distDeno div
  95.        gRad 2 mul div  B2g B1g sub mul B1g add } def
  96.   /pointblue { %% x pointblue bvalue
  97.     TextWidth add backM mul mywhy sub backB add abs distDeno div
  98.        gRad 2 mul div  B2b B1b sub mul B1b add } def
  99.   /pointgray { %% x pointgray grey
  100.     TextWidth add backM mul mywhy sub backB add abs distDeno div
  101.        gRad 2 mul div  B2v B1v sub mul B1v add } def
  102.   /mywhy 0 def
  103.   TextAngle rotate
  104.   /GrayStep Size def
  105.   0 TextRadius neg translate     
  106.   Font findfont [Size 0 0 Size 0 0 ] makefont setfont
  107.   TextRadius neg  Size  TextRadius {
  108.     TextWidth neg 0 moveto
  109.       { currentpoint pop /cpx exch def
  110.         cpx pointred  cpx pointgreen  cpx pointblue  cpx pointgray SMG pop
  111.       String show eol? {exit} if } loop
  112.     /mywhy mywhy Size 1.1 mul add def
  113.     0 Size 1.1 mul translate } for } if
  114. WashType 2 eq docomplex and %% Radius
  115.   { 1.25 setlinewidth 5 setflat
  116.     0 1 gRad
  117.       { /idx exch def newpath
  118.         Shade1 Shade2 gRad idx WGV SMG pop
  119.         /Rade idx .001 add def
  120.         0 0 Rade -15 375 arc stroke } for } if
  121.  WashType 1 eq docomplex and %% Log
  122.   { {dup mul} settransfer
  123.     WashAngle 90 sub rotate
  124.     0 gRad neg translate
  125.     1.1 setlinewidth
  126.     0 1 GrayDiameter
  127.       { /idx exch def newpath
  128.         Shade1 Shade2 GrayDiameter idx WGV SMG pop
  129.         gLen neg 0 moveto gLen 0 lineto stroke
  130.         newpath 0 1 translate } for } if
  131.  WashType 0 eq docomplex and %% Linear
  132.   { WashAngle 90 sub rotate
  133.     0 gRad neg translate
  134.     1.1 setlinewidth
  135.     0 1 GrayDiameter
  136.       { /idx exch def newpath
  137.         Shade1 Shade2 GrayDiameter idx WGV SMG pop
  138.         gLen neg 0 moveto gLen 0 lineto stroke
  139.         newpath 0 1 translate } for } if
  140. grestore
  141. %%
  142.